home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
mkmsgsrc.zip
/
MSGEXPRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-09-19
|
3KB
|
114 lines
Program MsgExprt;
{$IFDEF WINDOWS}
{$M 16384, 8196}
{$ELSE}
{$M 16384, 0, 655360}
{$ENDIF}
{$I MKB.Def}
{$X+}
{$IFDEF WINDOWS}
Uses MKWCrt,
{$ELSE}
Uses
{$IFDEF OPRO}
OpCrt,
{$ELSE}
Crt,
{$ENDIF}
{$ENDIF}
MKMsgAbs, MKMsgSqu, MKMsgFid, MKMsgHud, MKDos, MKstring;
Var
MsgOut: AbsMsgPtr;
TmpStr: String;
AreaId: String;
OutFile: Text;
OutName: String;
Const
StLen = 78;
Begin
If ParamCount < 2 Then
Begin
WriteLn('Proper syntax is:');
WriteLn('MsgExprt OutPut.Txt MsgAreaId');
WriteLn;
WriteLn(' Squish MsgAreaId Example = SC:\Max\Msg\Muffin');
WriteLn(' Hudson MsgAreaId Example = H042C:\MK\MsgBase');
WriteLn(' *.Msg MsgAreaId Example = FC:\Mail');
WriteLn;
Halt(1);
End;
AreaId := Upper(ParamStr(2));
OutName := Upper(ParamStr(1));
WriteLn('Exporting to ', OutName);
Assign(OutFile, OutName);
ReWrite(OutFile);
If IoResult <> 0 Then
Begin
WriteLn('Unable to create output file');
Halt(3);
End;
Case AreaId[1] of
'H': MsgOut := New(HudsonMsgPtr, Init);
'S': MsgOut := New(SqMsgPtr, Init);
'F': MsgOut := New(FidoMsgPtr, Init);
Else
Begin
WriteLn('Invalid message base type');
Halt(1);
End;
End;
MsgOut^.SetMsgPath(Copy(AreaId,2,128));
If MsgOut^.OpenMsgBase <> 0 Then
Begin
WriteLn('Error opening message base');
Halt(2);
End;
WriteLn;
WriteLn;
MsgOut^.SeekFirst(1);
While MsgOut^.SeekFound Do
Begin
WriteLn(OutFile, '--------------------------------------------------------------------------');
MsgOut^.MsgStartUp;
Write(OutFile, 'Message Number: ' + Long2Str(MsgOut^.GetMsgNum));
Write(#13);
Write(MsgOut^.GetMsgNum);
If MsgOut^.IsPriv Then
Write(OutFile,' (Priv)');
If MsgOut^.IsRcvd Then
Write(OutFile, ' (Rcvd)');
WriteLn(OutFile);
Write(OutFile, 'From: ' + PadRight(MsgOut^.GetFrom,' ',45));
Write(OutFile, 'Date: ');
WriteLn(OutFile, ReformatDate(MsgOut^.GetDate, 'MM/DD/YY')
+ ' ' + MsgOut^.GetTime);
WriteLn(OutFile, 'To: ' + MsgOut^.GetTo);
Write(OutFile, 'Subj: ');
WriteLn(OutFile,MsgOut^.GetSubj);
WriteLn(OutFile);
MsgOut^.MsgTxtStartUp;
TmpStr := MsgOut^.GetString(StLen);
While (Not MsgOut^.EOM) Do
Begin
WriteLn(OutFile, TmpStr);
TmpStr := MsgOut^.GetString(StLen);
End;
If IoResult <> 0 Then;
MsgOut^.SeekNext;
End;
Close(OutFile);
If IoResult <> 0 Then
Begin
WriteLn('Error in output file');
Halt(3);
End;
If MsgOut^.CloseMsgBase <> 0 Then;
Dispose(MsgOut, Done);
End.